home *** CD-ROM | disk | FTP | other *** search
/ PC Open 93 / PC Open 93 CD 1.bin / internet / AmphetaDesk / lib / AmphetaDesk.pm next >
Encoding:
Perl POD Document  |  2002-10-23  |  14.7 KB  |  290 lines
  1. package AmphetaDesk;
  2. ###############################################################################
  3. # AmphetaDesk                                           (c) 2000-2002 Disobey #
  4. # morbus@disobey.com                      http://www.disobey.com/amphetadesk/ #
  5. ###############################################################################
  6. # ABOUT THIS PACKAGE:                                                         #
  7. #   This the starting point of everything related to AmphetaDesk. The main    #
  8. #   purpose of this script is to act as a traffic cop between the webserver   #
  9. #   and the GUI libraries. It implements a pathetic queuing system, as well   #
  10. #   as sends all the data to the various modules and the web browser.         #
  11. #                                                                             #
  12. # LIST OF ROUTINES BELOW:                                                     #
  13. #   init - creates the environment and sets up the queue based loop.          #
  14. ###############################################################################
  15. #               "moving on down the world. looking for a place."              #
  16. ###############################################################################
  17.  
  18. use strict; $|++;
  19. use CGI qw/:standard :cgi-lib/;
  20. use AmphetaDesk::Channels;
  21. use AmphetaDesk::ChannelsList;
  22. use AmphetaDesk::MyChannels;
  23. use AmphetaDesk::Settings;
  24. use AmphetaDesk::Templates;
  25. use AmphetaDesk::Utilities;
  26. use AmphetaDesk::Versioning;
  27. use AmphetaDesk::WebServer;
  28. use AmphetaDesk::WWW;
  29. use File::Spec::Functions;
  30. require Exporter;
  31. use vars qw( @ISA @EXPORT );
  32. @ISA = qw( Exporter );
  33. @EXPORT = qw( init );
  34.  
  35. # define a quickie die message on quits.
  36. $SIG{INT} = sub { die "User cancelled" } unless $^O =~ /Mac/;
  37.  
  38. # where are we?
  39. use FindBin qw($Bin);
  40. BEGIN { unshift(@INC, catdir($Bin, "lib")); }
  41.  
  42. ###############################################################################
  43. # init - creates the environment and sets up the queue based loop.            #
  44. ###############################################################################
  45. # USAGE:                                                                      #
  46. #   init( $wrapper_ver );                                                     #
  47. #                                                                             #
  48. # NOTES:                                                                      #
  49. #   This routine accepts the version number of the wrapper file that          #
  50. #   calls the init() routine. This allows us some bit of backwards            #
  51. #   compatibility if the wrapper ever changes.                                #
  52. #                                                                             #
  53. # RETURNS:                                                                    #
  54. #   n/a; if this routine fails, then Ampheta just ain't gonna work, bub.      #
  55. ###############################################################################
  56.  
  57. sub init {
  58.  
  59.    my ($wrapper_ver) = @_;
  60.  
  61.    ############################################################################
  62.    # 1.0 Initialization ("wake up, you angst-filled goose!")                  #
  63.    #                                                                          #
  64.    # Set up everything neccesary for a happy operation, include log files,    #
  65.    # settings, OS determination, GUI starts, version checks, channel updates, #
  66.    # and webserver binding. Once all this crap is done, start the infiniloop. #
  67.    ############################################################################
  68.  
  69.    # delete the logfile if it's over 250k,
  70.    # then reopen it and try to redir STDERR.
  71.    my $logfile = catfile($Bin, "AmphetaDesk.log");
  72.    if (-e $logfile) { unlink $logfile if -s $logfile > 250000; }
  73.    open (LOG, ">>$logfile") or die "AmphetaDesk couldn't open the logfile for logging: $!";
  74.    open(STDERR,">&LOG") or die "AmphetaDesk couldn't redirect errors to the logfile: $!";
  75.    select(LOG); $|++; select(STDOUT);      # turn on autoflushing for AmphetaDesk.log.
  76.    *AmphetaDesk::Utilities::LOG = \*LOG; # map our Utilities::LOG to this LOG filehandle.
  77.  
  78.    # load our settings. this routine is located in Settings.pm
  79.    # and takes care of determining the OS, finding all the paths
  80.    # to the relevant files, as well as making sure everything exists.
  81.    load_my_settings( catfile($Bin, "data", "mySettings.xml") );
  82.  
  83.    # load our os specific libraries. if we don't know, use the Linux
  84.    # libraries, which currently default to STDOUT for all gui processing.
  85.    if (get_setting("app_os") =~ /Win/) { require AmphetaDesk::OS::Windows; import AmphetaDesk::OS::Windows; }
  86.    elsif (get_setting("app_os") =~ /Mac/) { require AmphetaDesk::OS::MacOS; import AmphetaDesk::OS::MacOS; MacPerl::Quit(3); }
  87.    elsif (get_setting("app_os") =~ /darwin/) { require AmphetaDesk::OS::MacOSX; import AmphetaDesk::OS::MacOSX; }
  88.    else { require AmphetaDesk::OS::Linux; import AmphetaDesk::OS::Linux; }
  89.  
  90.    # start gui.
  91.    # os specific.
  92.    &gui_init;
  93.  
  94.    # output a little hello.
  95.    my $joy = ""; if (get_setting("app_os") eq "darwin") { $joy = "OS X? Good choice, my friend."; }
  96.    my ($app_ver) = get_setting("app_version"); # wow. how sad is *that* easter egg. pffff.
  97.    note("--------------------------------------------------------------------------------", 1);
  98.    note("Disobey.com's AmphetaDesk v$app_ver has started (using wrapper v$wrapper_ver).",   1);
  99.    note( get_setting("app_copyright") . " - " . get_setting("app_url"),                     1);
  100.    note("The operating system is '" .  get_setting("app_os") . "'. " . $joy,                0);
  101.    note("--------------------------------------------------------------------------------", 1);
  102.  
  103.    # check for a newer version.
  104.    # [located in Versioning.pm].
  105.    check_version;
  106.  
  107.    # load channel subscriptions, clean dead files, and download anything new.
  108.    note("Downloading the latest channel data. This may take a few minutes.",                1);
  109.    note("Wait patiently, eh? The latest news will be yours shortly!",                       1);
  110.    note("--------------------------------------------------------------------------------", 1);
  111.    load_my_channels( get_setting("files_myChannels") );
  112.    remove_old_channel_files; download_my_channels;
  113.  
  114.    # set our timer variable
  115.    # for repetitive downloading.
  116.    my $last_update = time;
  117.  
  118.    # start up the webserver(s).
  119.    # [located in WebServer.pm].
  120.    my $daemon = start_webserver;
  121.    my $radio_daemon = start_radio_webserver if get_setting("user_start_radio_webserver");
  122.  
  123.    # open a browser to
  124.    # load our index page.
  125.    open_url(); # os specific
  126.    note("--------------------------------------------------------------------------------", 1);
  127.  
  128.    ############################################################################
  129.    # 2.0 Start the Loop ("around and around spun alice.")                     #
  130.    #                                                                          #
  131.    # Now, we start the listening loop for our webserver. During our loop, we  #
  132.    # listen for specific connections and, if they're valid requests, we pass  #
  133.    # them to our Text::Template module for processing out to the browser.     #
  134.    ############################################################################
  135.  
  136.    # we put the user's "channels_check_interval" into a variable here, so
  137.    # we don't have get_setting calls every time we go through our infinite loop.
  138.    my $user_channels_check_interval = get_setting("user_channels_check_interval");
  139.  
  140.    while ( 1 ) {
  141.  
  142.       # listen for
  143.       # a gui event
  144.       &gui_listen;
  145.  
  146.       # if now is later than the user's "channels_check_interval", then 
  147.       # we download all our channels over again. 60 minutes is the minimum.
  148.       $user_channels_check_interval = 60 if $user_channels_check_interval < 60;
  149.       if ((time - $last_update) > $user_channels_check_interval * 60) {
  150.          $last_update = time; download_my_channels; # wHhheeEEE!
  151.       }
  152.  
  153.       # if we receive a connection, suck it in. if we
  154.       # don't, then we endlessly loop listening for either
  155.       # webserver or GUI requests until we're closed. we use
  156.       # one of those funky flipflops to determine if we should
  157.       # try listening on the $radio_daemon or not (since that
  158.       # functionality is off by default in our configuration).
  159.       my $connection = defined($radio_daemon) ? $daemon->accept || $radio_daemon->accept : $daemon->accept;
  160.  
  161.       # no connection? move on.
  162.       next unless defined $connection;
  163.  
  164.       # if we're this far, we've got a connection.
  165.       # get the browser's request from our connection.
  166.       my $request = $connection->get_request; next unless defined $request;
  167.  
  168.       # if this is an invalid URL (something funky with ..'s, or
  169.       # other characters we're not really fond of), then we send
  170.       # a cheapo message saying that we don't like them. this 
  171.       # should stop stuff like directory traversals, etc.
  172.       # note, we ->print and not ->send_error because HTTP::Daemon
  173.       # doesn't create a valid HTML document, and that's dumb.
  174.       if ($request->url->path !~ /^[\/A-Za-z0-9\-_\.]+$/ || $request->url->path =~ /\.\./) { 
  175.          $connection->print("<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n" .
  176.                             "<html><head><title>Forbidden</title></head><body>\n" .
  177.                             "<h1>Forbidden</h1> The server understood the request, " .
  178.                             "but is refusing to fulfill it. Please don't try again.\n" .
  179.                             "<hr><address>AmphetaDesk/" . get_setting("app_version") . " " . 
  180.                             "Server at 127.0.0.1 Port " . get_setting("urls_port") .
  181.                             "</address></body></html>");
  182.          next; # return to looping.
  183.       }
  184.  
  185.       # if there's a query string, remove the path information for
  186.       # CGI.pm and then feed it (or the POST in $request->content).
  187.       my $form_parameters; # this is the final holder of form variables.
  188.       if ( $request->uri =~ /\?/ ) {
  189.          $form_parameters = $request->uri;
  190.          $form_parameters =~ s/[^\?]+\?(.*)/$1/;
  191.       } else { $form_parameters = $request->content; }
  192.       $CGI::Q = new CGI($form_parameters);
  193.  
  194.       # process our various known form possibilities. these are in order
  195.       # of preference, and the "unknown_urls" and "del" are deprecated.
  196.       # individual templates can also use the param() to further react.
  197.       # add_url and del_url are both located in MyChannels.pm.
  198.       add_url( param('add_url') || join(",", param('add_urls')) || param('unknown_url') );
  199.       del_url( param('del_url') || join(",", param('del_urls')) || param('del') );
  200.  
  201.       # perhaps this is a Radio Userland subscription request?
  202.       # if so, add the url to our OPML, then redir back to our index.
  203.       if ($request->url->path =~ /system\/pages\/subscriptions/) {
  204.          my $home = "http://127.0.0.1:" . get_setting("urls_port") . "/index.html";
  205.          add_url( param('url') ); $connection->send_redirect($home);
  206.       }
  207.  
  208.       # if we see a 'reconfigure' variable, then we're to modify
  209.       # our AmphetaDesk settings, and save out a new copy. we pass
  210.       # a hash reference to our modify_my_settings, located in Settings.pm.
  211.       if (param('reconfigure')) { my $hash_ref = Vars; modify_my_settings($hash_ref); }
  212.  
  213.       # set the location of our requested filename. if this is a
  214.       # directory listings ("/"), then rewrite to become "/index.html".
  215.       my $requested_file = $request->url->path; $requested_file =~ s/^\///;
  216.       if ( get_setting("app_os") =~ /Mac/ ) { $requested_file =~ s/\//:/g; }
  217.       my $filename = catfile( get_setting("dir_templates"), $requested_file );
  218.       if ($filename =~ /[\/\\:]$/) { $filename .= "index.html"; }
  219.  
  220.       # now, we start serving the files. if this is an image and
  221.       # it exists, then we binmode it for Windows, and send it out.
  222.       if ( ( $filename =~ /(jpg|gif|png)$/ ) and -e $filename ) { 
  223.          open(IMG, $filename) or note("Oof! AmphetaDesk could not open $filename. " .
  224.                                       "Please report the following error to " .
  225.                                       get_setting("app_email") . ": $!", 1);
  226.  
  227.          # print out the http headers.
  228.          my $type = "image/$1";
  229.          $connection->send_basic_header();
  230.          $connection->print("Content-type: $type\015\012");
  231.          $connection->print("\015\012"); # no more headers.
  232.  
  233.          # and now the image.
  234.          binmode $connection; binmode IMG;
  235.          $connection->print($_) while <IMG>; close(IMG);
  236.       }
  237.  
  238.       # if the filename exists, pass it
  239.       # through AmphetaDesk::Templates.
  240.       elsif (-e $filename) {
  241.  
  242.          # print out the http headers.
  243.          $connection->send_basic_header();
  244.          $connection->print("Content-Type: text/html\015\012");
  245.          $connection->print("\015\012"); # no more headers.
  246.  
  247.          # fill it in, and then send it out. fun, fun.
  248.          # parse_template is located in AmphetaDesk::Templates.
  249.          $connection->print( parse_template($filename) );
  250.       }
  251.  
  252.       # no clue, so write out an "apache rulezzzzz" error page.
  253.       # note, we ->print and not ->send_error because HTTP::Daemon
  254.       # doesn't create a valid HTML document, nor could we get
  255.       # it to listen to our customized error message. we also don't
  256.       # ->send_basic_header(404, "Not Found") for a similar reason:
  257.       # we want to customize our error message, and any $msg we
  258.       # throw becomes part of the response code, which is bad.
  259.       else { # yeah. i love apache. more than you. or my burning ears.
  260.          $connection->send_basic_header();
  261.          $connection->print("Content-type: text/html\015\012");
  262.          $connection->print("\015\012"); # no more headers.
  263.          $connection->print("<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n" .
  264.                             "<html><head><title>Not Found</title></head><body>\n" .
  265.                             "<h1>Not Found</h1> The requested URL $requested_file was not found." .
  266.                             "<hr><address>AmphetaDesk/" . get_setting("app_version") . " " . 
  267.                             "Server at 127.0.0.1 Port " . get_setting("urls_port") .
  268.                             "</address></body></html>\n");
  269.       }
  270.  
  271.       # all done with this request.
  272.       $connection->close;
  273.    }
  274.  
  275.    ############################################################################
  276.    # 3.0 The End ("the book closed silently. it was not done.")               #
  277.    #                                                                          #
  278.    # If we're here, then close out the program cos we've been banished rather #
  279.    # rudely from memory. We'll be waiting though. We'll show you. Muhahah.    #
  280.    # Shut down our open file and pipe handles, and then exit miserably.       #
  281.    ############################################################################
  282.  
  283.    END {
  284.      save_my_channels; save_my_settings;
  285.      close LOG; $daemon->shutdown(2) if $daemon;
  286.    } exit;
  287.  
  288. }
  289.  
  290. 1;